home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / hypercrd / xcmd / dxcmds34.sit / Dartmouth XCMD's 3.4.3 / card_7962.txt < prev    next >
Text File  |  1990-04-17  |  7KB  |  258 lines
  1. -- card: 7962 from stack: in.3
  2. -- bmap block id: 0
  3. -- flags: 4000
  4. -- background id: 3241
  5. -- name: RInstall
  6. ----- HyperTalk script -----
  7. on Install
  8.   get ChooseTargetStack()
  9.   InstallResource XCMD,RInstall,it
  10. end Install
  11.  
  12.  
  13. -- part 1 (field)
  14. -- low flags: 81
  15. -- high flags: 2007
  16. -- rect: left=12 top=26 right=298 bottom=491
  17. -- title width / last selected line: 0
  18. -- icon id / first selected line: 0 / 0
  19. -- text alignment: 0
  20. -- font id: 22
  21. -- text size: 10
  22. -- style flags: 0
  23. -- line height: 13
  24. -- part name: Source
  25.  
  26.  
  27. -- part 2 (button)
  28. -- low flags: 00
  29. -- high flags: A003
  30. -- rect: left=299 top=300 right=322 bottom=438
  31. -- title width / last selected line: 0
  32. -- icon id / first selected line: 0 / 0
  33. -- text alignment: 1
  34. -- font id: 0
  35. -- text size: 12
  36. -- style flags: 0
  37. -- line height: 16
  38. -- part name: Show Pascal Source
  39. ----- HyperTalk script -----
  40. on mouseUp
  41.   set the visible of card field 1 to not the visible of card field 1
  42.   if the visible of card field 1 is true then
  43.     set the name of me to "Hide Pascal Source"
  44.   else set the name of me to "Show Pascal Source"
  45. end mouseUp
  46.  
  47.  
  48.  
  49. -- part contents for background part 16
  50. ----- text -----
  51. RINSTALL XCMD version 1.1
  52. Kevin Calhoun
  53.  
  54. RInstall copies any resource contained in any currently open resource file to a file you specify by full pathname.  It automatically removes from the target file any resource of the same type and name (or of the same type and resource ID) as the resource to be copied.
  55.  
  56. INVOKING RINSTALL
  57.  
  58. RInstall resType,resName,fileName
  59.  
  60. The first parameter, resType, is that type of resource you want to install.  The second parameter, resName, is the name of the resource you want to install.  The third parameter, fileName, is the full pathname of the file into which the resource is to be copied.
  61.  
  62. If an error occurs, RInstall returns an error message, the first word of which is 
  63. "Error".
  64.  
  65. REVISION HISTORY
  66. 30 April 1989  1.0
  67. 22 July 1989  No longer leaves a NIL master pointer behind when replacing a resource.
  68.  
  69. -- part contents for card part 1
  70. ----- text -----
  71. UNIT RInstall;
  72.  
  73. { RInstall XCMD ┬⌐1989 by the Trustees of Dartmouth College }
  74. { Written by Kevin Calhoun }
  75.  
  76. (*
  77. Pascal RInstall.p
  78. Link  -m ENTRYPOINT Γêé
  79.     -o "YourFile" Γêé
  80.     -rt XCMD=3128 Γêé
  81.     -sn Main=RInstall Γêé
  82.     RInstall.p.o Γêé
  83.     "{Libraries}"interface.o Γêé
  84.     "{PLibraries}"Paslib.o Γêé
  85.     "{Libraries}"HyperXLib.o
  86. *)
  87.  
  88. {$R-}
  89.  
  90. INTERFACE
  91.   USES
  92.     Types,
  93.     Memory,
  94.     Events,
  95.     Windows,
  96.     Files,
  97.     ToolUtils,
  98.     Resources,
  99.     SysEqu,
  100.     Errors,
  101.     HyperXCmd;
  102.  
  103.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  104.  
  105. IMPLEMENTATION
  106.  
  107.   PROCEDURE ResInstall (paramPtr : XCMDPtr); FORWARD;
  108.  
  109.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  110.   BEGIN
  111.     ResInstall(paramPtr);
  112.   END;
  113.  
  114.   PROCEDURE PassReturnValue (paramPtr: XCMDPtr; theMsg : Str255); { set theResult and quit }
  115.   BEGIN
  116.     paramPtr^.returnValue := PasToZero(paramPtr, theMsg);
  117.   END;
  118.  
  119.   FUNCTION MyOpenResFile(fileName: Str255; VAR refNum: INTEGER;
  120.                           VAR wasOpen: BOOLEAN): OSErr;
  121.     TYPE
  122.       HandlePtr = ^Handle;
  123.     VAR
  124.       oldTopMapHndl: Handle;
  125.   BEGIN
  126.     MyOpenResFile := noErr;
  127.     oldTopMapHndl := HandlePtr(TopMapHndl)^;  { remember current TopMapHndl }
  128.     refNum := OpenResFile(fileName);          { open resource file }
  129.     IF (refNum = -1) THEN { error opening file }
  130.       BEGIN
  131.       MyOpenResFile := ResError;
  132.       EXIT(MyOpenResFile);
  133.       END
  134.     ELSE
  135.       IF (oldTopMapHndl = HandlePtr(TopMapHndl)^) THEN wasOpen := TRUE
  136.         { no change -- it was open }
  137.       ELSE wasOpen := FALSE;
  138.         { res file wasn't open before }
  139.   END;
  140.  
  141.   PROCEDURE RemoveResource(rType: ResType; resID: INTEGER; name: Str255);
  142.     VAR
  143.       resAlready: Handle;
  144.   BEGIN
  145.     SetResLoad(FALSE);
  146.     REPEAT
  147.       resAlready := Get1Resource(rType, resID);
  148.       IF resAlready <> NIL THEN
  149.         BEGIN
  150.           RmveResource(resAlready);
  151.           DisposHandle(resAlready);
  152.         END;
  153.     UNTIL resAlready = NIL;
  154.     REPEAT
  155.       resAlready := Get1NamedResource(rType, name);
  156.       IF resAlready <> NIL THEN
  157.         BEGIN
  158.           RmveResource(resAlready);
  159.           DisposHandle(resAlready);
  160.         END;
  161.     UNTIL resAlready = NIL;
  162.     SetResLoad(TRUE);
  163.   END;
  164.     
  165.   PROCEDURE ResInstall(paramPtr: XCMDPtr);
  166.     LABEL
  167.       99,100;
  168.     VAR
  169.       err: OSErr;
  170.       targetFile, curFile: INTEGER;
  171.       str: Str255;
  172.       rType: ResType;
  173.       resource: Handle;
  174.       resID: INTEGER;
  175.       attrs: INTEGER;
  176.       targetStack: Str255;
  177.       wasOpen: BOOLEAN;
  178.       
  179.       PROCEDURE SetReturnValue;
  180.       BEGIN
  181.         IF err <> noErr THEN
  182.           BEGIN
  183.           NumToStr(paramPtr, err, str);
  184.           PassReturnValue(paramPtr,CONCAT('Error ', str));
  185.           END;
  186.       END;
  187.       
  188.       PROCEDURE BailOut;
  189.       BEGIN
  190.         IF resource <> NIL THEN DisposHandle(resource);
  191.         SetReturnValue;
  192.         EXIT(ResInstall);
  193.       END;
  194.  
  195.   BEGIN
  196.     err := noErr;
  197.     resource := NIL;
  198.     curFile := CurResFile;
  199.     
  200.     IF paramPtr^.paramCount < 3 THEN
  201.       BEGIN
  202.       PassReturnValue(paramPtr,'RInstall XCMD 1.1 ┬⌐1989 Dartmouth College');
  203.       Exit(ResInstall);
  204.       END;
  205.       
  206.     BlockMove(paramPtr^.params[1]^,@rType,4);
  207.     ZeroToPas(paramPtr, paramPtr^.params[2]^, str);
  208.     
  209.     resource := GetNamedResource(rType, str);
  210.     err := ResError;
  211.     IF err <> noErr THEN GOTO 100;
  212.     
  213.     GetResInfo(resource, resID, rType, str);
  214.     err := ResError;
  215.     IF err <> noErr THEN BailOut;
  216.  
  217.     attrs := GetResAttrs(resource);
  218.     
  219.     err := HandToHand(resource);
  220.     IF err <> noErr THEN BailOut;
  221.     
  222.     MoveHHi(resource);
  223.     HLock(resource);
  224.       
  225.     ZeroToPas(paramPtr,paramPtr^.params[3]^,targetStack);
  226.     
  227.     err := MyOpenResFile(targetStack, targetFile, wasOpen);
  228.     IF (targetFile = -1) AND (err = eofErr) THEN
  229.       BEGIN
  230.       wasOpen := FALSE;
  231.       CreateResFile(targetStack);
  232.       err := ResError;
  233.       IF err = noErr THEN targetFile := OpenResFile(targetStack);
  234.       END;
  235.     IF (err <> noErr) OR (targetFile = -1) THEN BailOut;
  236.  
  237.     UseResFile(targetFile);
  238.     RemoveResource(rType, resID, str);
  239.     AddResource(resource, rType, resID, str);
  240.     err := ResError;
  241.     IF err <> noErr THEN
  242.       BEGIN
  243.       DisposHandle(resource);
  244.       GOTO 99;
  245.       END;
  246.  
  247.     SetResAttrs(resource, attrs);
  248.     ChangedResource(resource);
  249.     WriteResource(resource);
  250.     UpdateResFile(targetFile);
  251.     err := ResError;
  252.     IF NOT wasOpen THEN CloseResFile(targetFile);
  253.     
  254.     99: UseResFile(curFile);
  255.     100: SetReturnValue;
  256.   END;
  257.  
  258. END.